home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok22.lha / Cube / SolidCUBE.mod < prev    next >
Text File  |  1993-08-15  |  9KB  |  364 lines
  1. (*******************************************************************************
  2.  :Program.         SolidCUBE.MOD
  3.  :Author.          Carsten Wartmann / Mathematics by André Theiler
  4.  :Address.         Wutzkyallee 83, D-1000 Berlin 47
  5.  :Phone.           030/6614776
  6.  :Version.         1.5
  7.  :Date.            3/89
  8.  :Copyright.       PD
  9.  :Language.        Modula-2
  10.  :Compiler.        M2Amiga V3.2d
  11.  :Contents.        Echtzeitanimation eines Würfels
  12. *******************************************************************************)
  13.  
  14. (* More Info : See DOC-File...                                                *)
  15.  
  16.  
  17. MODULE SolidCUBE ;
  18.  
  19. FROM SYSTEM      IMPORT BITSET,ADR,FFP,ADDRESS ;
  20.  
  21. FROM Intuition   IMPORT NewScreen,ScreenPtr,OpenScreen,CloseScreen,customScreen,
  22.                         NewWindow,WindowPtr,ScreenToFront,
  23.                         IDCMPFlags,IDCMPFlagSet,WindowFlags,WindowFlagSet,
  24.                         OpenWindow,CloseWindow ;
  25.  
  26. FROM Graphics    IMPORT ViewModes,ViewModeSet,Move,Draw,SetAPen,jam1,
  27.                         RastPortPtr,ClearScreen,SetRGB4,TmpRas,AreaInfo,
  28.                         InitArea,InitTmpRas,AreaEnd,AreaMove,AreaDraw,
  29.                         FreeRaster,AllocRaster,WaitBOVP,ViewPortPtr ;
  30.  
  31. FROM MathLibFFP  IMPORT sin,cos,pi ;
  32.  
  33.  
  34. CONST PUNKTE      =  8     ;
  35.       PproFLAECHE =  4     ;
  36.       FLAECHEN    =  6     ;
  37.       BEOX        =  0.0   ;      (* Standort des Beobachters *)
  38.       BEOY        = -400.0 ;
  39.       BEOZ        =  0.0   ;
  40.  
  41.  
  42. VAR screen           : NewScreen ;
  43.     screenptr        : ARRAY [0..1] OF ScreenPtr ;
  44.     window           : NewWindow ;
  45.     windowptr        : ARRAY [0..1] OF WindowPtr ;
  46.     drawRP           : ARRAY [0..1] OF RastPortPtr ;
  47.     viewP            : ARRAY [0..1] OF ViewPortPtr ;
  48.     cia[0BFE000H]    : BITSET ;
  49.     Joy1[0DFF00CH]   : BITSET ;
  50.     buffer           : ARRAY [0..1],[0..255] OF INTEGER ;
  51.     tmp              : ARRAY [0..1] OF TmpRas ;
  52.     areainfo         : ARRAY [0..1] OF AreaInfo ;
  53.     mem              : ARRAY [0..1] OF ADDRESS ;
  54.     scr1,scr0,scra,i : INTEGER ;
  55.     x,y,z            : ARRAY [0..PUNKTE] OF FFP ;
  56.     flaeche          : ARRAY [0..FLAECHEN*PproFLAECHE] OF INTEGER ;
  57.     beox,beoy,beoz   : FFP ;
  58.     drehz,drehy      : FFP ;
  59.  
  60.  
  61. PROCEDURE Rechts() : BOOLEAN ;         (* Routinen zur Joystickabfrage *)
  62.    BEGIN
  63.       RETURN (1 IN Joy1) ;
  64. END Rechts ;
  65.  
  66. PROCEDURE Links() : BOOLEAN ;
  67.    BEGIN
  68.       RETURN (9 IN Joy1) ;
  69. END Links ;
  70.  
  71. PROCEDURE XOR(a,b : BOOLEAN) : BOOLEAN ;
  72.    BEGIN
  73.       RETURN ((a OR b) AND NOT (a AND b)) ;
  74. END XOR ;
  75.  
  76. PROCEDURE Unten() : BOOLEAN ;
  77.    BEGIN
  78.       RETURN XOR(Rechts(),(0 IN Joy1)) ;
  79. END Unten ;
  80.  
  81. PROCEDURE Oben() : BOOLEAN ;
  82.    BEGIN
  83.       RETURN XOR(Links(),(8 IN Joy1)) ;
  84. END Oben ;
  85.  
  86.  
  87. PROCEDURE RotY(wi : FFP) ;           (* Drehung um die Y-Achse*)
  88.  
  89. VAR i     : INTEGER ;
  90.     xx,zz : FFP ;
  91.  
  92.    BEGIN
  93.  
  94.      FOR i := 0 TO PUNKTE-1 DO
  95.  
  96.        xx := x[i] ;
  97.        zz := z[i] ;
  98.        x[i] := xx * cos(wi) + zz * sin(wi) ;
  99.        z[i] := zz * cos(wi) - xx * sin(wi) ;
  100.  
  101.      END (*FOR*) ;
  102.  
  103. END RotY ;
  104.  
  105.  
  106. PROCEDURE RotZ(wi : FFP) ;          (* Drehung um die Z-Achse *)
  107.  
  108. VAR i     : INTEGER ;
  109.     xx,yy : FFP ;
  110.  
  111.    BEGIN
  112.  
  113.      FOR i := 0 TO PUNKTE-1 DO
  114.  
  115.        xx := x[i] ;
  116.        yy := y[i] ;
  117.        x[i] := xx * cos(wi) - yy * sin(wi) ;
  118.        y[i] := xx * sin(wi) + yy * cos(wi) ;
  119.  
  120.      END (*FOR*) ;
  121.  
  122. END RotZ ;
  123.  
  124.  
  125. PROCEDURE Zeichne ;
  126.  
  127. VAR i,j,l,ii                            : INTEGER ;
  128.     xbild,ybild                         : INTEGER ;
  129.     fehler                              : LONGINT ;
  130.     vx,vy,vz,wx,wy,wz,px,py,
  131.     pz,sx,sy,sz,q                       : FFP ;
  132.  
  133.  BEGIN
  134.  
  135.     FOR l := 0 TO FLAECHEN-1 DO
  136.  
  137.       ii := l * PproFLAECHE ;
  138.  
  139.       vx := x[flaeche[ii+1]] - x[flaeche[ii]] ;
  140.       vy := y[flaeche[ii+1]] - y[flaeche[ii]] ;
  141.       vz := z[flaeche[ii+1]] - z[flaeche[ii]] ;
  142.  
  143.       wx := x[flaeche[ii+2]] - x[flaeche[ii]] ;
  144.       wy := y[flaeche[ii+2]] - y[flaeche[ii]] ;
  145.       wz := z[flaeche[ii+2]] - z[flaeche[ii]] ;
  146.  
  147.       px := vy*wz - vz*wy ;
  148.       py := vz*wx - vx*wz ;
  149.       pz := vx*wy - vy*wx ;
  150.  
  151.       sx := x[flaeche[ii]] - beox ;
  152.       sy := y[flaeche[ii]] - beoy ;
  153.       sz := z[flaeche[ii]] - beoz ;
  154.  
  155.       q  := sx*px + sy*py + sz*pz ;
  156.  
  157.       IF NOT(q<0.0) THEN
  158.  
  159.          FOR j := 0 TO PproFLAECHE-1 DO
  160.  
  161.             i := flaeche[l * PproFLAECHE + j] ;
  162.  
  163.             xbild := 160 + TRUNC(beox + beoy / (beoy - y[i]) * (x[i] - beox)) ;
  164.             ybild := 120 + TRUNC(beoz + beoy / (beoy - y[i]) * (z[i] - beoz)) ;
  165.  
  166.             IF (j<1) THEN
  167.                fehler := AreaMove(drawRP[scr0],xbild,ybild) ;
  168.             ELSE
  169.               fehler := AreaDraw(drawRP[scr0],xbild,ybild) ;
  170.             END (*IF*) ;
  171.  
  172.          END (*FOR j*) ;
  173.  
  174.          SetAPen(drawRP[scr0],l+1) ;
  175.          fehler := AreaEnd(drawRP[scr0]) ;
  176.  
  177.        END (*IF q>0.0*) ;
  178.  
  179.     END (*FOR l*) ;
  180.  
  181. END Zeichne ;
  182.  
  183.  
  184. PROCEDURE Rotate ;
  185.  
  186. VAR    i   : INTEGER ;
  187.  
  188.   BEGIN
  189.  
  190.       x[0] := 30.0 ;              (* Punktkoordinaten *)
  191.       y[0] := 30.0 ;
  192.       z[0] := 30.0 ;
  193.  
  194.       x[1] := 30.0 ;
  195.       y[1] := 30.0 ;
  196.       z[1] := -30.0 ;
  197.  
  198.       x[2] := 30.0 ;
  199.       y[2] := -30.0 ;
  200.       z[2] := -30.0 ;
  201.  
  202.       x[3] := 30.0 ;
  203.       y[3] := -30.0 ;
  204.       z[3] := 30.0 ;
  205.  
  206.       x[4] := -30.0 ;
  207.       y[4] := 30.0 ;
  208.       z[4] := 30.0 ;
  209.  
  210.       x[5] := -30.0 ;
  211.       y[5] := 30.0 ;
  212.       z[5] := -30.0 ;
  213.  
  214.       x[6] := -30.0 ;
  215.       y[6] := -30.0 ;
  216.       z[6] := -30.0 ;
  217.  
  218.       x[7] := -30.0 ;
  219.       y[7] := -30.0 ;
  220.       z[7] := 30.0 ;
  221.  
  222.  
  223.       flaeche[0] := 0 ;             (* Flaechenzuordnung der Punkte *)
  224.       flaeche[1] := 1 ;
  225.       flaeche[2] := 2 ;
  226.       flaeche[3] := 3 ;
  227.  
  228.       flaeche[4] := 4 ;
  229.       flaeche[5] := 7 ;
  230.       flaeche[6] := 6 ;
  231.       flaeche[7] := 5 ;
  232.  
  233.       flaeche[8]  := 0 ;
  234.       flaeche[9]  := 4 ;
  235.       flaeche[10] := 5 ;
  236.       flaeche[11] := 1 ;
  237.  
  238.       flaeche[12] := 3 ;
  239.       flaeche[13] := 2 ;
  240.       flaeche[14] := 6 ;
  241.       flaeche[15] := 7 ;
  242.  
  243.       flaeche[16] := 1 ;
  244.       flaeche[17] := 5 ;
  245.       flaeche[18] := 6 ;
  246.       flaeche[19] := 2 ;
  247.  
  248.       flaeche[20] := 0 ;
  249.       flaeche[21] := 3 ;
  250.       flaeche[22] := 7 ;
  251.       flaeche[23] := 4 ;
  252.  
  253.       drehz := 10.0 * pi / 180.0 ;           (* Winkelgeschwindigkeit *)
  254.       drehy := 10.0 * pi / 180.0 ;           (* der Drehung           *)
  255.       scr0  := 0 ;
  256.       scr1  := 1 ;
  257.  
  258.     WHILE (6 IN cia) DO                      (* Solange bis Mausknopf *)
  259.  
  260.         Zeichne ;
  261.         WaitBOVP(viewP[scr1]) ;
  262.         ScreenToFront(screenptr[scr0]) ;
  263.  
  264.         WHILE (NOT(Rechts() OR Links() OR Unten() OR Oben()
  265.                OR (NOT(6 IN cia)))) DO
  266.  
  267.         END (*WHILE*) ;
  268.  
  269.         IF (7 IN cia) THEN
  270.  
  271.            IF Rechts() THEN
  272.              RotY(-drehz) ;
  273.            END ;
  274.  
  275.            IF Links() THEN
  276.              RotY(drehz) ;
  277.            END ;
  278.  
  279.            IF Oben() THEN
  280.              RotZ(drehy) ;
  281.            END ;
  282.  
  283.            IF Unten() THEN
  284.              RotZ(-drehy) ;
  285.            END (*IF*) ;
  286.  
  287.         END (*IF*) ;
  288.  
  289.         IF (Unten() AND (NOT(7 IN cia)))   THEN
  290.           beoy := beoy + 10.0 ;                   (* Beobachter entfernen *)
  291.           IF (beoy > (-60.0)) THEN
  292.              beoy := -60.0 ;
  293.           END (*IF*) ;
  294.  
  295.         ELSIF (Oben() AND (NOT(7 IN cia))) THEN
  296.           beoy := beoy - 10.0 ;                   (* Beobachter annähern  *)
  297.           IF (beoy < (-1800.0)) THEN
  298.              beoy := -1800.0 ;
  299.           END (*IF*) ;
  300.  
  301.         END (*IF*) ;
  302.  
  303.         scra := scr0 ;
  304.         scr0 := scr1 ;
  305.         scr1 := scra ;
  306.  
  307.         Move(drawRP[scr0],0,0) ;
  308.         ClearScreen(drawRP[scr0]) ;
  309.  
  310.     END (*WHILE*) ;
  311.  
  312. END Rotate ;
  313.  
  314.  
  315. BEGIN (* Hauptprogramm Screens *)
  316.  
  317.    FOR i := 0 TO 1 DO
  318.  
  319.      WITH screen DO                     (* Stark verkuerzt !!! *)
  320.         width    := 320 ;               (* Vorsicht : Bei Aenderungen *)
  321.         height   := 256 ;               (* am besten alles auffuehren *)
  322.         depth    := 3 ;
  323.      END (*WITH*) ;
  324.  
  325.        screenptr[i] := OpenScreen(screen) ;
  326.  
  327.      WITH window DO
  328.         width := 320 ;
  329.         height := 255 ;
  330.         screen      := screenptr[i] ;
  331.      END (*WITH*) ;
  332.  
  333.      windowptr[i] := OpenWindow(window) ;
  334.  
  335.      drawRP[i] := windowptr[i]^.rPort ;
  336.      viewP[i]  := ADR(screenptr[i]^.viewPort) ;
  337.  
  338.      mem[i]  := AllocRaster(320,256) ;
  339.      InitArea(areainfo[i],ADR(buffer[i,0]),8) ;
  340.  
  341.      InitTmpRas(tmp[i],mem[i],20) ;
  342.      windowptr[i]^.rPort^.tmpRas   := ADR(tmp[i]) ;
  343.      windowptr[i]^.rPort^.areaInfo := ADR(areainfo[i]) ;
  344.  
  345.    END (*FOR i*) ;
  346.  
  347.  
  348.    beox := BEOX ;
  349.    beoy := BEOY ;
  350.    beoz := BEOZ ;
  351.  
  352.    Rotate ;
  353.  
  354.    FOR i := 0 TO 1 DO
  355.  
  356.      CloseWindow(windowptr[i]) ;
  357.      CloseScreen(screenptr[i]) ;
  358.      FreeRaster(mem[i],320,256) ;
  359.  
  360.    END (*FOR i*) ;
  361.  
  362. END SolidCUBE .
  363.  
  364.